Attribute VB_Name = "modTrig" Option Explicit Public Type MeasureData ' UDT for holding GPIB measurements on the TDS7000, sDisplayName As String ' display name in frmTc.lstMeas, measurement unit, and sGPIB As String ' selection status sUnit As String blnSelected As Boolean End Type Public arrMeas(0 To 21) As MeasureData 'array of measurements for TDS (<8000) scopes Public Const AppName = "Capture on Trigger Demo" ' constant for use in message boxes Public nScopeType As Integer ' integer variable for holding scope series number e.g. 7000 or 8000 Public sScopeType As String ' string variable for the same use Public tvcRef As TVCLib.Tvc ' reference to tvc control on frmTC for use by routines in other modules Public blnWFM As Boolean ' holds user choice on capturing waveform data Public blnMEAS As Boolean ' holds user choice on capturing measurement data Public blnShowInGrid As Boolean ' holds user choice on displaying captured data in grid Public blnSaveToFile As Boolean ' holds user choice on saving captured data to disk Public sFileName As String ' file name for storing data Dim tcol As Long, vcol As Long ' variables for holding column values when building data display Dim sMode As String, strCMD As String ' string variables in building GPIB command sets Dim nCHCount As Integer ' holds number of channels selected Public ntracker As Integer ' tracking variable for triggerd captures Public nCount As Integer ' holds total number of captures Private m_HoldBuffer() As Byte ' buffer for building string to store to disk Private m_byteTracker As Long ' ' tracking variable for insertion position into buffer Public CancelFlag As Boolean ' Using this API copy memory function dramatically increases the speed of concatenating strings in Visual Basic '(see code in ConcatInBuffer routine) Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Public Sub ConcatInBuffer(ByRef s1 As String) ' this routine uses CopyMemory (Alias for RtlMoveMemory) API call to speed up ' string concatenation in VB; enormous difference in performance Static Len_s1 As Long ' Get Byte length of passed text. Len_s1 = LenB(s1) If Len_s1 > 0 Then ' Copy passed string into preallocated buffer. Call CopyMemory(m_HoldBuffer(m_byteTracker), ByVal StrPtr(s1), Len_s1) ' increment byte tracking variable by byte length of passed string m_byteTracker = m_byteTracker + Len_s1 End If End Sub Public Function GetTimeBaseInt(s1 As String) As Integer ' this function returns an integer value for timebase which is required on the CSA8000 scope s1 = UCase(s1) Select Case s1 Case "MAIN" GetTimeBaseInt = 1 Case "MAG1" GetTimeBaseInt = 2 Case "MAG3" GetTimeBaseInt = 3 Case Else GetTimeBaseInt = 1 End Select End Function Public Function GetChannelInt8K(s1 As String) As Integer ' returns integer for use in GetWaveform command s1 = UCase(s1) Select Case s1 Case "CH1" GetChannelInt8K = 1 Case "CH2" GetChannelInt8K = 2 Case "CH3" GetChannelInt8K = 3 Case "CH4" GetChannelInt8K = 4 Case "CH5" GetChannelInt8K = 5 Case "CH6" GetChannelInt8K = 6 Case "CH7" GetChannelInt8K = 7 Case "CH8" GetChannelInt8K = 8 Case "MATH1" GetChannelInt8K = 9 Case "MATH2" GetChannelInt8K = 10 Case "MATH3" GetChannelInt8K = 11 Case "MATH4" GetChannelInt8K = 12 Case "MATH5" GetChannelInt8K = 13 Case "MATH6" GetChannelInt8K = 14 Case "MATH7" GetChannelInt8K = 15 Case "MATH8" GetChannelInt8K = 16 Case Else GetChannelInt8K = 1 End Select End Function Public Sub PopulateMeasArray() Dim i As Integer ' initialize array values for display name and GPIB commands arrMeas(0).sDisplayName = "AMPLITUDE" arrMeas(1).sDisplayName = "AREA" arrMeas(2).sDisplayName = "BURST" arrMeas(3).sDisplayName = "CYCLE AREA" arrMeas(4).sDisplayName = "CYCLE MEAN" arrMeas(5).sDisplayName = "CYCLE RMS" arrMeas(6).sDisplayName = "DELAY" arrMeas(7).sDisplayName = "FALL TIME" arrMeas(8).sDisplayName = "FREQUENCY" arrMeas(9).sDisplayName = "MAX VOLTAGE" arrMeas(10).sDisplayName = "MIN VOLTAGE" arrMeas(11).sDisplayName = "NEGATIVE DUTY" arrMeas(12).sDisplayName = "NEGATIVE OVERSHOOT" arrMeas(13).sDisplayName = "NEGATIVE PULSE WIDTH" arrMeas(14).sDisplayName = "PERIOD" arrMeas(15).sDisplayName = "PEAK-TO-PEAK" arrMeas(16).sDisplayName = "PHASE" arrMeas(17).sDisplayName = "POSITIVE DUTY" arrMeas(18).sDisplayName = "POSITIVE OVERSHOOT" arrMeas(19).sDisplayName = "POSITIVE PULSE WIDTH" arrMeas(20).sDisplayName = "RISE TIME" arrMeas(21).sDisplayName = "ROOT MEAN SQUARE" ' populate the array for actual GPIB measurement commands arrMeas(0).sGPIB = "AMPLITUDE" arrMeas(1).sGPIB = "AREA" arrMeas(2).sGPIB = "BURST" arrMeas(3).sGPIB = "CAREA" arrMeas(4).sGPIB = "CMEAN" arrMeas(5).sGPIB = "CRMS" arrMeas(6).sGPIB = "DELAY" arrMeas(7).sGPIB = "FALL" arrMeas(8).sGPIB = "FREQUENCY" arrMeas(9).sGPIB = "MAXIMUM" arrMeas(10).sGPIB = "MINIMUM" arrMeas(11).sGPIB = "NDUTY" arrMeas(12).sGPIB = "NOVERSHOOT" arrMeas(13).sGPIB = "NWIDTH" arrMeas(14).sGPIB = "PERIOD" arrMeas(15).sGPIB = "PK2PK" arrMeas(16).sGPIB = "PHASE" arrMeas(17).sGPIB = "PDUTY" arrMeas(18).sGPIB = "POVERSHOOT" arrMeas(19).sGPIB = "PWIDTH" arrMeas(20).sGPIB = "RISE" arrMeas(21).sGPIB = "RMS" ' populate the array for units '(V-volts;S-seconds;VS-voltseconds;P-perecentage; HZ hertz) arrMeas(0).sUnit = "V" arrMeas(1).sUnit = "VS" arrMeas(2).sUnit = "S" arrMeas(3).sUnit = "VS" arrMeas(4).sUnit = "V" arrMeas(5).sUnit = "V" arrMeas(6).sUnit = "S" arrMeas(7).sUnit = "S" arrMeas(8).sUnit = "HZ" arrMeas(9).sUnit = "V" arrMeas(10).sUnit = "V" arrMeas(11).sUnit = "P" arrMeas(12).sUnit = "P" arrMeas(13).sUnit = "S" arrMeas(14).sUnit = "S" arrMeas(15).sUnit = "V" arrMeas(16).sUnit = "S" arrMeas(17).sUnit = "P" arrMeas(18).sUnit = "P" arrMeas(19).sUnit = "S" arrMeas(20).sUnit = "S" arrMeas(21).sUnit = "V" ' populate the lstMeas list box frmTC.lstMeas.Clear For i = 0 To 21 frmTC.lstMeas.AddItem arrMeas(i).sDisplayName Next frmTC.lstMeas.Selected(0) = True End Sub Public Sub CheckTabVisibility(chkM As VB.CheckBox, ssTabTVC As TabDlg.SSTab) ' this routine makes the appropriate tabs visible based upon scope type Select Case nScopeType Case 5000, 7000 If chkM.Value = vbUnchecked Then ssTabTVC.TabVisible(1) = False ssTabTVC.TabVisible(2) = False ElseIf chkM.Value = vbChecked Then ssTabTVC.TabVisible(1) = True ssTabTVC.TabVisible(2) = False ' ssTabTVC.Tab = 1 End If Case 8000 If chkM.Value = vbUnchecked Then ssTabTVC.TabVisible(1) = False ssTabTVC.TabVisible(2) = False ElseIf chkM.Value = vbChecked Then ssTabTVC.TabVisible(1) = False ssTabTVC.TabVisible(2) = True Call Refresh8000Meas End If End Select End Sub Public Sub Build8000Controls() ' this routine loads a control array for use with CSA8000 scopes Dim i As Integer frmTC.ssTabTVC.TabVisible(2) = True DoEvents frmTC.ssTabTVC.Tab = 2 frmTC.chkMeas(0).Caption = "Measure 1" If frmTC.chkMeas.Count > 1 Then Exit Sub For i = 1 To 7 Load frmTC.chkMeas(i) Load frmTC.lblMDesc(i) frmTC.chkMeas(i).Caption = "Measure" & Str$(i + 1) frmTC.chkMeas(i).Top = frmTC.chkMeas(i - 1).Top + frmTC.chkMeas(i - 1).Height + 50 frmTC.lblMDesc(i).Top = frmTC.lblMDesc(i - 1).Top + frmTC.lblMDesc(i - 1).Height + 50 frmTC.chkMeas(i).Visible = True frmTC.lblMDesc(i).Visible = True Next DoEvents frmTC.Refresh End Sub Public Sub Refresh8000Meas() ' loads the display on the CSA8000 measurement tab or requeries setup measurements on the scope If frmTC.chkMeas.UBound = 0 Then Call Build8000Controls End If Call frmTC.cmdShowMeas_Click End Sub Public Function RemoveLF(s1 As String) As String ' function to remove the linefeed character from returned GPIB commands If Right(s1, 1) = vbLf Then RemoveLF = Left(s1, Len(s1) - 1) Else RemoveLF = s1 End If End Function Public Sub FormatTV(tv As TreeView) 'formats the Treeview control Dim w As Long Dim n As Node If nScopeType = 7000 Then With tv .Style = tvwTreelinesPlusMinusText .LineStyle = tvwRootLines .Nodes.Clear End With End If End Sub Public Sub Main() On Error GoTo SubMainErr 'starting routine Load frmTC 'load form frmTC.Show DoEvents Screen.MousePointer = vbHourglass Set tvcRef = frmTC.Tvc1 Call PopulateNumCaptures(frmTC.cboNumCaptures) ' populate the number of capture choices Screen.MousePointer = vbDefault Exit Sub SubMainErr: Dim msg As String msg = "Error: " & Err.Number & " " & Err.Description MsgBox msg, vbOKOnly, AppName End Sub Public Function GetScopeType(t As TVCLib.Tvc, sst As TabDlg.SSTab) As Boolean Dim s1 As String 'Assigns values to the global variables specifying type of scope to which the application 'is currently connected. Calls CheckTabVisibility routine to make the appropriate Measurement 'tab visible. On Error GoTo GetScopeTypeERR s1 = t.InstrumentModel Select Case UCase(Left(s1, 4)) Case "TDS5" nScopeType = 5000 sScopeType = "TDS5000" Call CheckTabVisibility(frmTC.chkM, frmTC.ssTabTVC) GetScopeType = True Case "TDS7" nScopeType = 7000 sScopeType = "TDS7000" Call CheckTabVisibility(frmTC.chkM, frmTC.ssTabTVC) GetScopeType = True Case "CSA8" nScopeType = 8000 sScopeType = "CSA8000" Call CheckTabVisibility(frmTC.chkM, frmTC.ssTabTVC) GetScopeType = True Case Else nScopeType = 0 sScopeType = "NONE" GetScopeType = False End Select Exit Function GetScopeTypeERR: Dim msg As String msg = "Error: " & Err.Number & " " & Err.Description MsgBox msg, vbOKOnly, AppName End Function Public Sub PopulateNumCaptures(c As ComboBox) Dim i With c .Clear For i = 1 To 100 c.AddItem i Next .ListIndex = 0 End With End Sub Public Sub GetDevices(t As TVCLib.Tvc, lst As ListBox) Dim s1 As String, i As Integer Dim arr 'this routine queries the FindList property of the TVC control and lists connected devices ' could be local machine or scopes running VXI-11 server On Error GoTo GetDeviceERR lst.Clear Screen.MousePointer = vbHourglass arr = t.FindList If IsArray(arr) Then For i = LBound(arr) To UBound(arr) lst.AddItem (arr(i)) Next Else lst.AddItem "No devices found" Screen.MousePointer = vbDefault End If Screen.MousePointer = vbDefault Exit Sub GetDeviceERR: Screen.MousePointer = vbDefault Dim msg As String msg = "Error: " & Err.Number & " " & Err.Description MsgBox msg, vbOKOnly, AppName End Sub Private Sub DisplayChannels8000(tv As TreeView) ' see the comment on the DisplayChannels routine ' this code is very similar except it also tests for MAG1 and MAG2 ' timebase views in the CSA8000 scope; these are added as child nodes to ' the active channels Dim cmd As String Dim cmdTB As String Dim blnMag1 As Boolean, blnMag2 As Boolean Dim retval As String, sQry As String Dim arr As Variant, arrLst() As String Dim i As Integer, j As Integer Dim lb As Integer Dim ub As Integer Dim strHold As String, strCH As String Dim testpos As Integer, nLength As Integer Dim strControlCH As String Dim ntracker As Integer Dim nHoldFocus As Integer Dim n As Node On Error GoTo DispCH8000Err If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 End If cmd = "VERBOSE ON;HEADER OFF" tvcRef.WriteString cmd ' check mag1 level cmdTB = "HORIZONTAL:MAG1:VIEW?" tvcRef.WriteString cmdTB retval = tvcRef.ReadString If RemoveLF(retval) = "1" Then blnMag1 = True End If 'check mag2 level If blnMag1 Then cmdTB = "HORIZONTAL:MAG2:VIEW?" tvcRef.WriteString cmdTB retval = tvcRef.ReadString If RemoveLF(retval) = "1" Then blnMag2 = True End If End If cmd = "SELECT?" tvcRef.WriteString cmd retval = tvcRef.ReadString If retval <> "" Then arr = Split(retval, ";") Else tv.Nodes.Clear Set n = tv.Nodes.Add(, , , "NONE") End If ntracker = 0 If IsArray(arr) Then lb = LBound(arr) ub = UBound(arr) For i = lb To ub Select Case i Case 0 To 7 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "CH" & (i + 1) ntracker = ntracker + 1 Else ' parse the verbose version for regular channels If Right(strHold, 1) = "1" Then strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case 8 To 15 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' verbose instruction did not work ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "MATH" & (i - 7) ntracker = ntracker + 1 Else If Right(strHold, 1) = "1" Then ' parse it for MATH channels strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case 15 To 23 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' verbose instruction did not work ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "REF" & (i - 14) ntracker = ntracker + 1 Else If Right(strHold, 1) = "1" Then ' parse it for REF channels strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case ub ' exit if no active channels If ntracker = 0 Then tv.Nodes.Clear Set n = tv.Nodes.Add(, , , "NONE") End If 'clear treeview tv.Nodes.Clear ' display in treeview For j = LBound(arrLst) To UBound(arrLst) Set n = tv.Nodes.Add(, , arrLst(j), arrLst(j)) Set n = tv.Nodes.Add(arrLst(j), tvwChild, arrLst(j) & "-MAIN", "MAIN") If blnMag1 Then Set n = tv.Nodes.Add(arrLst(j), tvwChild, arrLst(j) & "-MAG1", "MAG1") n.EnsureVisible End If If blnMag2 Then Set n = tv.Nodes.Add(arrLst(j), tvwChild, arrLst(j) & "-MAG2", "MAG2") n.EnsureVisible End If Next frmTC.lstCH.Clear If tv.Nodes.Count >= 2 Then tv.Nodes(2).Selected = True Call frmTC.TV1_NodeClick(ByVal tv.Nodes(2)) End If End Select Next 'display the record length sQry = "HEADER OFF;:HORIZONTAL:MAIN:RECORDLENGTH?" tvcRef.WriteString sQry retval = "" retval = tvcRef.ReadString If Not retval = "" Then frmTC.lblRS.Caption = retval End If Exit Sub DispCH8000Err: MsgBox "Error: " & Err.Number & ", " & Err.Description Resume Next End Sub Public Sub DisplayChannels(tv As TreeView) '********************************************************************************************** 'This routine detects which channels are open and which channel is the active measurement 'channel. Result are displayed in the lstCH listbox, which has two columns. The left hand 'column displays active channels; the measurement channel is indicated by the word 'Control' in 'the right hand column. The SELECT? GPIB command on the 7000 and 5000 scopes returns a semicolon separated string 'with 13 values, 4 channel, 4 math, 4 ref and 1 indicating the measurement channel at the end of the string. 'If the channel is active, a numeral "1" is returned. If it is inactive a numeral "0" is returned. 'This routine parses the semicolon-separated string and uses the values to build nodes which 'populate the Treeview control. A separate routine is called for the 8000 scope '********************************************************************************************** Dim cmd As String Dim retval As String, sQry As String Dim arrLst() As String ' array that holds active channel; array is walked at end of routine to populate TreeView Dim arr As Variant ' holds array of strings created by reading the result from SELECT? GPIB command Dim i As Integer, j As Integer Dim lb As Integer Dim ub As Integer Dim strHold As String, strCH As String Dim testpos As Integer, nLength As Integer Dim strControlCH As String Dim ntracker As Integer Dim nHoldFocus As Integer Dim n As Node On Error GoTo DispCHErr ' bind TVC control pointer if necessary If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 End If Select Case nScopeType Case 8000 Call DisplayChannels8000(tv) Exit Sub Case 7000, 5000 cmd = "HEADER OFF; VERBOSE ON" tvcRef.WriteString cmd cmd = "SELECT?" tvcRef.WriteString cmd retval = tvcRef.ReadString If retval <> "" Then arr = Split(retval, ";") Else tv.Nodes.Clear Exit Sub End If ntracker = 0 If IsArray(arr) Then lb = LBound(arr) ub = UBound(arr) For i = lb To ub Select Case i Case 0 To 3 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' verbose instruction did not work ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "CH" & (i + 1) ntracker = ntracker + 1 Else ' parse the verbose version for regular channels If Right(strHold, 1) = "1" Then strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case 4 To 7 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' verbose instruction did not work ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "MATH" & (i - 3) ntracker = ntracker + 1 Else If Right(strHold, 1) = "1" Then ' parse it for MATH channels strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case 8 To 11 strHold = Trim(arr(i)) nLength = Len(strHold) If nLength = 1 And strHold = "1" Then ' verbose instruction did not work ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = "REF" & (i - 7) ntracker = ntracker + 1 Else If Right(strHold, 1) = "1" Then ' parse it for MATH channels strHold = Trim(Left(strHold, Len(strHold) - 1)) ReDim Preserve arrLst(0 To ntracker) As String arrLst(ntracker) = strHold ntracker = ntracker + 1 End If End If Case ub ' exit if no active channnels If ntracker = 0 Then tv.Nodes.Clear ' the Add method of the Nodes Collection Set n = tv.Nodes.Add(, , "NONE", "NONE") End If ' code to identify active channels strHold = Trim(arr(i)) nLength = Len(strHold) If nLength < 7 Then strControlCH = Left(strHold, nLength - 1) Else If UCase(Left(strHold, 7)) = "CONTROL" Then testpos = InStr(strHold, Chr$(32)) If testpos <> 0 Then strHold = Right(strHold, Len(strHold) - testpos) strControlCH = Left(strHold, Len(strHold) - 1) End If End If End If 'clear treeview tv.Nodes.Clear ' display in treeview control For j = LBound(arrLst) To UBound(arrLst) Set n = tv.Nodes.Add(, , arrLst(j), arrLst(j)) Next For j = 1 To tv.Nodes.Count If tv.Nodes(j).Text = strControlCH Then Set n = tv.Nodes.Add(tv.Nodes(j).Key, tvwChild, "CONTROL", "CONTROL") n.EnsureVisible Exit For End If Next frmTC.lstCH.Clear tv.Nodes(1).Selected = True Call frmTC.TV1_NodeClick(ByVal tv.Nodes(1)) Case Else End Select Next 'display the record length sQry = "HEADER OFF;:HORIZONTAL:RECORDLENGTH?" tvcRef.WriteString sQry retval = "" retval = tvcRef.ReadString If Not retval = "" Then frmTC.lblRS.Caption = retval End If End Select Exit Sub DispCHErr: MsgBox "Error: " & Err.Number & ", " & Err.Description, vbOKOnly, AppName End Sub Sub GetAcquisition8000() 'this code sets the registers in preparation for a trigger which activates a ServiceRequest 'event in the TVC control. See the GPIB programmer's guide for the CSA8000 scope Dim sCHCommands As String Dim nCH As Integer sCHCommands = "DESE 1;*ESE 1;*SRE 32" If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 With tvcRef .WriteString "ACQUIRE:STATE OFF" '.WriteString "WFMOUTPRE:ENCDG ASCII" .WriteString "ACQUIRE:STOPAFTER:CONDITION ACQWFS" .WriteString "ACQUIRE:STOPAFTER:COUNT 20" .WriteString "ACQUIRE:STOPAFTER:MODE CONDITION" .WriteString "ACQUIRE:DATA CLEAR" .WriteString sCHCommands .WriteString "*CLS" .WriteString "ACQUIRE:STATE RUN" .WriteString "*OPC" End With End Sub Sub GetAcquisition() 'This code sets the registers in preparation for a trigger which activates a ServiceRequest 'event in the TVC control. See the GPIB programmer's guide for the TDS series scopes. Dim sCHCommands As String sCHCommands = "DESE 1;*ESE 1;*SRE 32" If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 With tvcRef .WriteString "TRIGGER:A:MODE NORMAL" .WriteString "ACQUIRE:STATE OFF" .WriteString "ACQUIRE:STOPAFTER SEQUENCE" .WriteString sCHCommands .WriteString "*CLS" .WriteString "ACQUIRE:STATE RUN" .WriteString "*OPC" End With End Sub Public Sub SRQHandler() '***************************************************************************************************** 'This routine handles a call from the tvc control's Service Request event. It captures and displays 'waveforms from user-selected channels and also user-specified measurements from the active measurement 'channel when a trigger occurs and the service request bits are changed in the scope. '****************************************************************************************************** Dim wfm Dim xinc As Double Dim trigpos As Long Dim sQry As String, sRet As String Dim reclength As Long, bufsize As Long, i As Long, j As Long Dim t As Double, w As Single Dim arrAssign() As Double Dim arrhold() As String, hold As String, sTemp As String Dim semipos As Integer Dim nMeasTrack As Integer Dim sTStamp As String Dim nCHCount As Integer, nCH_Hold As Integer, nCH As Integer, nstart As Integer Dim sCH As String Dim nMeasRows As Integer, fnum As Integer Dim srow As Long Dim vUnits As String, hUnits As String Dim lstCH As VB.ListBox Dim g As MSFlexGridLib.MSFlexGrid Dim sHoldVal As String Dim nSizeVal As Integer Const sep = "," Set lstCH = frmTC.lstCH Set g = frmTC.grdData On Error GoTo SRQHandlerERR DoEvents ' helps handle cancel button If ntracker >= nCount Then Exit Sub ' finished collecting user-defined # of captures ' make sure TVCRef is available DoEvents ' helps handle cancel button If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 ' switch to tab for display frmTC.ssTabTVC.Tab = 3 frmTC.grdData.Redraw = True frmTC.Refresh DoEvents ' stop other service requests tvcRef.WriteString "DESE 0; *ESE 0; *SRE 0; *CLS" ' get number of selected items nCHCount = lstCH.ListCount If blnWFM Then ' no channel selected so exit If nCHCount = 0 Then MsgBox "No channels selected.", vbOKOnly, AppName Exit Sub End If End If If ntracker = 0 Then tcol = 0 vcol = 1 End If 'specify starting row If blnMEAS Then srow = 1 Else srow = 0 End If sTStamp = Format(Now, "ttttt") If blnMEAS Then ' build measurement data first 'call routine which builds the GPIB command for retrieving measurements Call BuildCMDString tvcRef.WriteString strCMD sRet = tvcRef.ReadString If blnSaveToFile And sFileName = "" Then Call HandleSaveDialog End If If blnSaveToFile And sFileName <> "" Then ' check to see if we have a file to write to 'if so open it to add data fnum = FreeFile Open sFileName For Append As #fnum ' place the return value into an array arrhold = Split(sRet, ";") nMeasTrack = 0 ' There is a correspondence between the ordinal value of the measurement in the ' array build from the return string (arrhold) and the ordinal value of selected ' measurements in arrMeas For i = LBound(arrMeas) To UBound(arrMeas) If arrMeas(i).blnSelected = True Then 'returns a semicolon separated string, first part with value, second part with engineering unit hold = GetEUnit(Str$(arrhold(nMeasTrack)), arrMeas(i).sUnit) If hold <> "Error" Then semipos = InStr(hold, ";") sTemp = "" sTemp = arrMeas(i).sDisplayName & "(" & Right(hold, Trim(Len(hold) - semipos)) & ")" sTemp = sTemp & ", " & RemoveLF(arrhold(nMeasTrack)) Print #fnum, sTemp End If nMeasTrack = nMeasTrack + 1 End If Next Close #fnum End If If blnShowInGrid Then ' user wishes to display measurement data in grid If ntracker = 0 Then g.Redraw = False g.Rows = 30 ' set the number of columns in the grid If blnWFM Then g.Cols = (nCHCount * nCount) + 1 Else g.Cols = nCount + 1 End If ' write column headers g.Row = srow g.Col = tcol g.Text = "Measurement" g.Col = vcol g.Text = "Value" g.Redraw = True End If If sRet <> "" Then If ntracker = 0 Then ' call routine to display measurement data 'fourth parameter is true if this is the first display of measurement data nMeasRows = DisplayMEASData(sRet, srow, tcol, True, g) Else If blnWFM Then ' adjust the column value If nCHCount = 1 Then ' one channel only, but need to accommodate multiple captures If ntracker <= 1 Then vcol = vcol + 1 ElseIf nCHCount > 1 And ntracker = 0 Then ' more than one channel and first time through; need to increment vcol = vcol + 1 End If srow = 1 nMeasRows = DisplayMEASData(sRet, srow, vcol, False, g) Else vcol = vcol + 1 nMeasRows = DisplayMEASData(sRet, srow, vcol, False, g) End If End If End If End If End If frmTC.lblStatus = "Acquiring data..." frmTC.Refresh DoEvents ' walk through the selected channels for waveform data For i = 0 To lstCH.ListCount - 1 sCH = lstCH.List(i) ' use in column header and in getting integer value for GetWaveform call nCH = GetChannelInt(sCH) 'used in GetWaveform function If blnWFM Then ' get waveform data If blnSaveToFile And sFileName = "" Then Call HandleSaveDialog End If If blnMEAS Then ' adjust startrow data if measurements included srow = nMeasRows + 3 End If 'get the waveform for the first channel Call tvcRef.GetWaveform(nCH, wfm, xinc, trigpos, vUnits, hUnits) ' get the record length reclength = 0 sQry = "HORIZONTAL:RECORDLENGTH?" tvcRef.WriteString sQry reclength = CLng(tvcRef.ReadString) If blnSaveToFile And sFileName <> "" Then ' calculate a buffer size: ' Two doubles (time and value) formatted at a possible 16 characters each. ' Add 3 characters (comma separator, carriage return, and line feed) for a total of ' 35 characters. Unicode requires two bytes per character for 70 bytes. Throw in ' an additional 4028 bytes for good measure bufsize = (reclength * 70) + 4028 ' allocate buffer memory for string to be written to disk ReDim m_HoldBuffer(0 To bufsize) As Byte ' set byte tracking variable m_byteTracker = 0 For j = LBound(wfm) To UBound(wfm) ' calculate time value t = (j - trigpos) * xinc nSizeVal = 35 'Len(t) + Len(wfm(j)) + 3 ' generate buffer for inserting time, comma, waveform value, carriage return, and linefeed ' Space function generates two byte characters internally sHoldVal = Space(nSizeVal) ' insert values into line buffer Mid(sHoldVal, 1) = Format$(t, "#.#0000000000000") Mid(sHoldVal, 16) = sep Mid(sHoldVal, 17) = Format$(wfm(j), "#.#0000000000000") Mid(sHoldVal, 33) = vbCrLf ' pass it to routine for building string Call ConcatInBuffer(sHoldVal) Next ' open file fnum = FreeFile Open sFileName For Append As #fnum nMeasTrack = 0 ' print column header sTemp = "TIME, VALUE(" & sCH & ")" & vbCrLf Print #fnum, sTemp 'assign buffer to string sTemp = m_HoldBuffer ' find the first null character in buffer and take everything to the left of it If InStr(sTemp, Chr$(0)) <> 0 Then sTemp = Left(sTemp, InStr(1, sTemp, Chr$(0)) - 1) End If ' write it to disk Print #fnum, sTemp Close #fnum 'clear file name variable if we have walked through all channels selected for 'waveform capturing If i >= lstCH.ListCount - 1 Then sFileName = "" End If End If If blnShowInGrid Then ' If ntracker = 0 And i = 0 Then ' first time through so set it up g.Redraw = False g.Cols = (nCHCount * nCount) + 1 g.Rows = reclength + 30 g.FixedRows = 1 g.FixedCols = 0 g.Row = srow g.Col = tcol g.Text = "Time" g.Row = srow g.Col = 1 g.Text = sCH ' display the data For j = LBound(wfm) To UBound(wfm) t = (j - trigpos) * xinc g.Row = j + srow g.Col = tcol g.Text = t g.Col = vcol g.Text = CDbl(wfm(j)) DoEvents If CancelFlag Then g.Redraw = True Exit Sub End If Next g.Redraw = True End If ' adjust column and display data If i > 0 Or ntracker > 0 Then If Not blnMEAS Then vcol = vcol + 1 Else If ntracker = 0 And i = 1 Then vcol = vcol + 1 End If End If g.Redraw = False g.Row = srow g.Col = vcol g.Text = sCH For j = LBound(wfm) To UBound(wfm) g.Col = vcol g.Row = j + srow g.Text = CDbl(wfm(j)) DoEvents If CancelFlag Then g.Redraw = True Exit Sub End If Next g.Redraw = True If blnMEAS Then vcol = vcol + 1 End If End If End If Next frmTC.lblStatus = "" frmTC.Refresh DoEvents ntracker = ntracker + 1 ' reset the registers for another trigger Call GetAcquisition Exit Sub SRQHandlerERR: MsgBox "Error: " & Err.Number & ": " & Err.Description Resume End Sub Function ParseQueryResults(s1 As String, QType As String) As String 'ParseQuery routine to read different acquistion 'parameter data, including the trigger source channel. Although this is not used in this example, 'it is included as example code for applications that need to more closely control trigger 'parameters. 's1 is the return value indicating PULSE, EDGE, or LOGIC Dim sTest As String Dim nTestPos As Integer, nSpacepos As Integer Dim i Dim sHold As String Dim nSourceCH As Integer sTest = Trim(s1) nTestPos = InStr(sTest, Chr$(32)) If nTestPos = 0 Then nTestPos = InStr(sTest, vbLf) If nTestPos <> 0 Then sHold = UCase(Left(sTest, Len(sTest) - 1)) Else sHold = UCase(sTest) End If Else For i = Len(sTest) To 1 Step -1 If Mid(sTest, i, 1) = Chr$(32) Then nSpacepos = i Exit For End If Next If i <= 1 Then ' no space character nTestPos = InStr(sTest, vbLf) If nTestPos <> 0 Then sHold = UCase(Left(sTest, Len(sTest) - 1)) Else sHold = UCase(sTest) End If Else ' space character exists sTest = Right(sTest, Len(sTest) - i) nTestPos = InStr(sTest, vbLf) If nTestPos <> 0 Then sHold = UCase(Left(sTest, Len(sTest) - 1)) Else sHold = UCase(sTest) End If End If End If Select Case QType Case "TRIGGER_SOURCE" Select Case sHold Case "PULSE" ParseQueryResults = "TRIGGER:A:PULSE:SOURCE?" Case "EDGE" ParseQueryResults = "TRIGGER:A:EDGE:SOURCE?" End Select Case "SOURCE_CHANNEL" ' demo code only Select Case sHold Case "CH1" nSourceCH = 1 Case "CH2" nSourceCH = 2 Case "CH3" nSourceCH = 3 Case "CH4" nSourceCH = 4 Case Else nSourceCH = 1 End Select ParseQueryResults = sHold End Select End Function Private Function GetChannelInt(pass As String) As Integer ' returns the integer for the chosen channel; used in TVC.GetWaveform method calls Select Case UCase(pass) Case "CH1" GetChannelInt = 1 Case "CH2" GetChannelInt = 2 Case "CH3" GetChannelInt = 3 Case "CH4" GetChannelInt = 4 Case "MATH1" GetChannelInt = 5 Case "MATH2" GetChannelInt = 6 Case "MATH3" GetChannelInt = 7 Case "MATH4" GetChannelInt = 8 End Select End Function Private Sub BuildCMDString8000() Dim i As Integer, j As Integer Dim sGetChannel As String Dim sRet As String ' this routine builds the command string for taking measurements from the CSA8000 scope strCMD = "" ' build the command string by going through the control array For i = frmTC.chkMeas.LBound To frmTC.chkMeas.UBound If frmTC.chkMeas(i).Value = vbChecked Then strCMD = strCMD & "MEASUREMENT:MEAS" & i + 1 & ":TYPE?;:MEASUREMENT:MEAS" & i + 1 & ":VALUE?;:" End If Next ' trim trailing ";:" If strCMD <> "" Then strCMD = Left(strCMD, Len(strCMD) - 2) End If ' add a header off command strCMD = "HEADER OFF;:" & strCMD End Sub Private Sub BuildCMDString() '************************************************************************************** 'This routine builds the command string for taking measurements from the 7000 scope. 'Concatenates user choices for measurements '************************************************************************************* Dim i As Integer, j As Integer Dim sGetChannel As String Dim nPhaseChannel As Integer, nDelayChannel As Integer Dim sRet As String Const CMDMEAS = "MEASUREMENT:IMMED:TYPE " Const CMDVALUE = ";:MEASUREMENT:IMMED:VALUE?;:" strCMD = "" ' build the command string For i = LBound(arrMeas) To UBound(arrMeas) If arrMeas(i).blnSelected = True Then If (arrMeas(i).sDisplayName <> "PHASE" And arrMeas(i).sDisplayName <> "DELAY") Then strCMD = strCMD & CMDMEAS & arrMeas(i).sGPIB & CMDVALUE Else For j = 1 To 8 sGetChannel = "MEASUREMENT:MEAS" & j & ":TYPE?" tvcRef.WriteString sGetChannel sRet = tvcRef.ReadString If UCase(Left(sRet, Len(sRet) - 1)) = arrMeas(i).sGPIB Then strCMD = strCMD & "MEASUREMENT:MEAS" & j & ":VALUE?;:" Exit For End If Next If j > 8 Then arrMeas(i).blnSelected = False End If End If Next ' trim trailing ";:" strCMD = Left(strCMD, Len(strCMD) - 2) ' add a header off command strCMD = "HEADER OFF;:" & strCMD End Sub Private Function DisplayMeasData8000(sRet As String, nRow As Long, nCol As Long, g As MSFlexGridLib.MSFlexGrid) As Integer 'sRet = string returned from scope;nRow = starting grid row; nCol = starting grid column 'g = grid reference 'called from SRQHandler routines Dim arrhold() As String Dim i As Integer, j As Integer, nTrack As Integer Dim nsize As Integer Dim sHoldType As String, sHoldValue As String Dim semipos As Integer arrhold = Split(sRet, ";") ' we return the type and the value in succession ' number of rows (nsize)is number of values in array divided by 2 If IsArray(arrhold) Then nsize = (UBound(arrhold) - LBound(arrhold) + 1) / 2 nTrack = 0 frmTC.ssTabTVC.Tab = 3 DoEvents g.Redraw = True For i = LBound(arrhold) To UBound(arrhold) With g If i Mod 2 = 0 Then .Col = nCol .Row = nRow + nTrack + 1 .Text = RemoveLF(arrhold(i)) Else .Col = nCol + 1 .Row = nRow + nTrack + 1 .Text = RemoveLF(arrhold(i)) nTrack = nTrack + 1 End If End With Next g.Redraw = True Else ' error - always should have at least two elements measurement type and value nsize = 0 End If DisplayMeasData8000 = nsize End Function Private Function DisplayMEASData(sRet As String, nRow As Long, nCol As Long, blnFirst As Boolean, g As MSFlexGridLib.MSFlexGrid) As Integer 'sRet = string returned from scope;nRow = starting grid row; nCol = starting grid column 'blnFirst = is the first time through and do we need row headers; g = grid reference 'called from SRQHandler routines Dim arrhold() As String, i As Integer, j As Integer, nTrack As Integer Dim nsize As Integer Dim hold As String, arrPaste() As String, sTemp As String Dim semipos As Integer Dim nDisplaySize As Integer ' find out the number of items in the return string If InStr(sRet, ";") <> 0 Then ' more than one measurement arrhold = Split(sRet, ";") nsize = UBound(arrhold) - LBound(arrhold) + 1 nTrack = 0 g.Redraw = False For i = LBound(arrMeas) To UBound(arrMeas) If arrMeas(i).blnSelected = True Then 'returns a semicolon separated string, first part with value, second part with engineering unit hold = GetEUnit(Str$(arrhold(nTrack)), arrMeas(i).sUnit) If hold <> "Error" Then semipos = InStr(hold, ";") sTemp = arrMeas(i).sDisplayName & "(" & Right(hold, Trim(Len(hold) - semipos)) & ")" If blnFirst Then ' show the Measurement row header data With g .Row = nTrack + nRow .Col = nCol .Text = sTemp .Col = nCol + 1 .Text = RemoveLF(arrhold(nTrack)) End With Else With g .Row = nTrack + nRow .Col = nCol .Text = RemoveLF(arrhold(nTrack)) End With End If Else g.Row = nTrack + nRow g.Col = nCol g.Text = "Err" End If nTrack = nTrack + 1 End If Next g.Redraw = True DisplayMEASData = nsize Else ' we have a single measurement nTrack = 0 For i = LBound(arrMeas) To UBound(arrMeas) If arrMeas(i).blnSelected = True Then hold = GetEUnit(sRet, arrMeas(i).sUnit) If hold <> "Error" Then semipos = InStr(hold, ";") sTemp = arrMeas(i).sDisplayName & "(" & Right(hold, Trim(Len(hold) - semipos)) & ")" If blnFirst Then g.Col = nCol g.Row = nTrack + nRow g.Text = sTemp g.Col = nCol + 1 g.Text = RemoveLF(sRet) Else g.Col = nCol g.Row = nTrack + nRow g.Text = RemoveLF(sRet) End If Else ' error g.Col = nCol g.Row = i + nRow g.Text = "Err" End If DisplayMEASData = 1 Exit For End If Next End If End Function Public Function GetEUnit(s1 As String, u As String) As String '********************************************************************************************************* ' This function returns a semicolon separated string. The string to the left of the semicolon represents ' the measurement's numeric value. The string to the right of the semicolon represents the engineering unit. ' The function multiplies the numeric value by a factor of 1000 depending upon the engineering unit ' detected (eg. milliseconds (ms), microseconds (us), nanoseconds(ns)) '************************************************************************************************************ Dim i As Integer Dim rNum As Double Dim nSlen As Integer Dim nZcount As Integer Dim nFirstNZ As Integer Dim nDecimalPos As Integer Dim sInt As String, sDecimal As String 'check for validity of passed value If IsNumeric(s1) Then ' check for perecentage value If u = "P" Then GetEUnit = s1 & "; %" Exit Function ElseIf u = "HZ" Then GetEUnit = s1 & "; Hz" Exit Function End If ' convert the string for multiplication later s1 = Format(s1, "########.##################") If IsNumeric(s1) Then rNum = CDbl(s1) Else rNum = 0 End If ' find the decimal position nDecimalPos = InStr(1, s1, ".") If nDecimalPos <> 0 Then Select Case nDecimalPos Case 1 sInt = "" sDecimal = Right(s1, Len(s1) - nDecimalPos) Case Else sInt = Left(s1, nDecimalPos - 1) sDecimal = Right(s1, Len(s1) - nDecimalPos) ' is there a leading zero? If Abs(Val(sInt)) <> 0 Then Select Case u Case "S" GetEUnit = rNum & "; s" Exit Function Case "V" GetEUnit = rNum & "; V" Exit Function Case "VS" GetEUnit = rNum & "; Vs" Exit Function End Select End If End Select Else ' integer value Select Case u Case "S" GetEUnit = rNum & "; s" Case "V" GetEUnit = rNum & "; V" Case "VS" GetEUnit = rNum & "; Vs" End Select End If Else GetEUnit = "Error" Exit Function End If nSlen = Len(sDecimal) nZcount = 0 For i = 1 To nSlen If Mid$(sDecimal, i, 1) = "0" Then nZcount = nZcount + 1 Else nFirstNZ = i - 1 Exit For End If Next Select Case nFirstNZ Case 0 To 3 rNum = rNum * 1000 Select Case u Case "S" GetEUnit = rNum & "; ms" Case "V" GetEUnit = rNum & "; mV" Case "VS" GetEUnit = rNum & "; mVs" End Select Case 4 To 6 rNum = rNum * 1000000 Select Case u Case "S" GetEUnit = rNum & "; us" Case "V" GetEUnit = rNum & "; uV" Case "VS" GetEUnit = rNum & "; uVs" End Select Case 7 To 9 rNum = rNum * 1000000000 Select Case u Case "S" GetEUnit = rNum & "; ns" Case "V" GetEUnit = rNum & "; nV" Case "VS" GetEUnit = rNum & "; nVs" End Select Case 10 To 12 rNum = rNum * (10 ^ 12) GetEUnit = rNum & "; ps" Case 13 To 15 rNum = rNum * (10 ^ 15) GetEUnit = rNum & "; fs" End Select End Function Public Sub SRQHandler8000() '***************************************************************************************************** 'This routine handles a call from the TVC control's Service Request event. It captures and displays 'waveforms from user-selected channels and also user-specified measurements from the active measurement 'channel when a trigger occurs and the service request bits are changed in the scope. '****************************************************************************************************** Dim wfm Dim arrhold() As String Dim xinc As Double, xoffset As Double Dim vUnits As String, hUnits As String Dim rVal As Double Dim nr_pt As Long Dim sQry As String, sRet As String Dim reclength As Long, i As Long, j As Long Dim t As Double, w As Single Dim sTStamp As String Dim nCHCount As Integer, nCH As Integer, nTB As Integer, nSizeVal As Integer Dim sCH As String Dim nMeasRows As Integer, nColCount As Integer Dim srow As Long Dim nDashPos As Integer Dim sSource As String, sTimebase As String Dim sHoldMType As String, sHoldMVal As String, sHoldVal As String, sTemp As String Dim fnum As Integer Dim bufsize As Long Dim lstCH As VB.ListBox Dim g As MSFlexGridLib.MSFlexGrid Const sep = "," Set lstCH = frmTC.lstCH Set g = frmTC.grdData On Error GoTo SRQHandler8000Err If ntracker >= nCount Then Exit Sub ' finished collecting user-defined # of captures ' make sure TVCRef is available If tvcRef Is Nothing Then Set tvcRef = frmTC.Tvc1 ' switch to tab for display frmTC.ssTabTVC.Tab = 3 frmTC.grdData.Redraw = True frmTC.Refresh DoEvents ' stop other service requests tvcRef.WriteString "DESE 0; *ESE 0; *SRE 0; *CLS" ' get number of selected channels nCHCount = lstCH.ListCount nColCount = ((nCHCount * 2) * nCount) + 2 g.Cols = nColCount If blnWFM Then ' no channel selected so exit If nCHCount = 0 Then Exit Sub End If If ntracker = 0 Then tcol = 0 vcol = 1 End If 'specify starting row If blnMEAS Then srow = 1 Else srow = 0 End If sTStamp = Format(Now, "ttttt") If blnMEAS Then ' build measurement data first Call BuildCMDString8000 tvcRef.WriteString strCMD sRet = tvcRef.ReadString If blnSaveToFile And sFileName = "" Then Call HandleSaveDialog End If If blnSaveToFile And sFileName <> "" Then fnum = FreeFile Open sFileName For Append As #fnum arrhold = Split(sRet, ";") For i = LBound(arrhold) To UBound(arrhold) If i Mod 2 = 0 Then sHoldMType = arrhold(i) ' measurement type info Else sHoldMVal = RemoveLF(arrhold(i)) sTemp = sHoldMType & ", " & sHoldMVal & vbCrLf Print #fnum, sTemp End If Next Close #fnum End If If blnShowInGrid Then If ntracker = 0 And i = 0 Then g.Redraw = False g.Rows = 30 g.Row = srow g.Col = tcol g.Text = "Measurement" g.Col = vcol g.Text = "Value" End If If sRet <> "" Then If blnWFM Then If nCHCount = 1 Then If ntracker <= 1 Then vcol = vcol + 1 ElseIf nCHCount > 1 And ntracker = 0 Then vcol = vcol + 1 End If srow = 1 nMeasRows = DisplayMeasData8000(sRet, srow, vcol, g) Else vcol = vcol + 1 nMeasRows = DisplayMeasData8000(sRet, srow, vcol, g) End If End If End If End If For i = 0 To lstCH.ListCount - 1 If blnWFM Then ' get waveform data ' get filename if we are saving to disk If blnSaveToFile And sFileName = "" Then Call HandleSaveDialog End If If blnMEAS Then ' adjust startrow data if measurements included srow = nMeasRows + 3 End If sCH = lstCH.List(i) ' use in column header and in getting integer value for GetWaveform call 'get the waveform for the first channel nDashPos = InStr(sCH, "-") If nDashPos <> 0 Then sSource = Left(sCH, nDashPos - 1) sTimebase = Right(sCH, Len(sCH) - nDashPos) Else Exit Sub End If nCH = GetChannelInt8K(sSource) nTB = GetTimeBaseInt(sTimebase) tvcRef.GetWaveform8K nCH, nTB, wfm, xinc, xoffset, vUnits, hUnits If blnSaveToFile And sFileName <> "" Then ' calculate a buffer size ' two doubles formatted at a possible 16 characters each or 32 bytes ' (unicode) each; 64 bytes for two doubles; (adjust for higher precision values) ' add an additional 6 bytes per record for a comma separator, carriage return, and line feed ' add 4028 bytes for good measure bufsize = 700000 ' CSA8000 has at most 5000 records per waveform ' allocate buffer memory for string to be written to disk ReDim m_HoldBuffer(0 To bufsize) As Byte ' set byte tracking variable m_byteTracker = 0 For j = LBound(wfm) To UBound(wfm) ' calculate time value t = j * xinc 'calculate size of line buffer to pass to routine 'build string for writing to disk nSizeVal = 35 'Len(t) + Len(wfm(j)) + 3 ' generate buffer for inserting time, comma, waveform value, carriage return, and linefeed sHoldVal = Space(nSizeVal) ' insert values into line buffer Mid(sHoldVal, 1) = Format$(t, "#.#0000000000000") Mid(sHoldVal, 16) = sep Mid(sHoldVal, 17) = Format$(wfm(j), "#.#0000000000000") Mid(sHoldVal, 33) = vbCrLf ' pass it to routine for building string Call ConcatInBuffer(sHoldVal) Next ' open file fnum = FreeFile Open sFileName For Append As #fnum ' print column header sTemp = "TIME, VALUE(" & sCH & ")" & vbCrLf Print #fnum, sTemp 'assign buffer to string sTemp = m_HoldBuffer ' find the first null character in buffer and take everything to the left of it If InStr(sTemp, Chr$(0)) <> 0 Then sTemp = Left(sTemp, InStr(1, sTemp, Chr$(0)) - 1) End If ' write it to disk Print #fnum, sTemp Close #fnum 'clear file name variable if we have walked through all channels selected for 'waveform capturing If i >= lstCH.ListCount - 1 Then sFileName = "" End If End If If blnShowInGrid Then g.FixedRows = 1 g.FixedCols = 0 g.Redraw = False g.Rows = 5002 ' CSA8000 returns no more than 5000 data points g.Row = srow g.Col = tcol g.Text = "Time" g.Row = srow g.Col = vcol g.Text = sCH For j = LBound(wfm) To UBound(wfm) t = (xinc * j) '+ xzero rVal = CDbl(wfm(j)) '(yscale * CDbl(wfm(j))) + yzero g.Row = j + srow + 1 g.Col = tcol g.Text = t g.Col = vcol g.Text = rVal Next g.Redraw = True tcol = tcol + 2 vcol = vcol + 2 End If End If Next ntracker = ntracker + 1 ' reset the registers for another trigger Call GetAcquisition8000 Exit Sub SRQHandler8000Err: Dim msg As String msg = "Error in SQRHandler8000 routine" MsgBox msg, vbOKOnly, AppName Resume End Sub Public Sub HandleSaveDialog() ' this routine uses the MS Common dialog control to open a file (timestamp default) for saving ' captured data to disk; called from SRQHandler routines Dim msg As String Dim sFileDefault As String Dim d As Date Dim fnum As Integer On Error GoTo cmdOKErr ' create a default timestamp file name d = Now sFileDefault = Format(d, "yy") & Format(d, "mm") & Format(d, "dd") _ & "_" & Format(d, "hh") & Format(d, "nn") & Format(d, "ss") With frmTC.dlgTVC .Flags = cdlOFNHideReadOnly + cdlOFNPathMustExist + cdlOFNExplorer + cdlOFNOverwritePrompt .DialogTitle = "Save Scope Data" .Filter = "Data files(*.dat)|*.dat|All files(*.*)|*.*" sFileDefault = sFileDefault & ".dat" .FileName = sFileDefault .FilterIndex = 1 .ShowOpen sFileName = .FileName fnum = FreeFile ' open and close to create file and erase any prior contents if it exists Open sFileName For Output As #fnum Close #fnum End With Exit Sub cmdOKErr: msg = "Error " & Err.Number & ": " & Err.Description Select Case Err.Number Case mscomdlg.cdlCancel sFileName = "" frmTC.chkSave.Value = vbUnchecked blnSaveToFile = False Exit Sub Case Else MsgBox msg, vbOKOnly, AppName End Select End Sub